Computer Select (Limited Edition)/Computer Select.iso/pcmag/v11n07/swrite.pas

Pascal/Delphi Source File | 1992-01-05 | 2KB | 99 lines

{$D-,L-,I-,R-,S-,V-}
Unit SWrite;
(**) INTERFACE (**)

PROCEDURE AssignWrite(var F: Text; Size: word;
  Accumulate : Boolean);
FUNCTION GetLastWritten : pChar;
FUNCTION GetLastWrittenC(VAR F : Text) : pChar;

(**) IMPLEMENTATION (**)
USES WinDos;

VAR _Buffer : pChar;   {Buffer to hold text passed to
                        NewInOutFunc. Size set by user}


  FUNCTION GetLastWritten : PChar;
  BEGIN
    GetLastWritten := _Buffer;
  END;

  FUNCTION GetLastWrittenC(VAR F : Text): PChar;
  BEGIN
    GetLastWrittenC := _Buffer;
    TTextRec (F).BufPos := 0;
  END;

  FUNCTION NewOpenFunc(var F: tTextRec): integer; FAR;
  BEGIN
    NewOpenFunc := 104; {file not open for input}
    WITH F DO
      IF Mode=fmOutput THEN {no error if opened with Rewrite}
        NewOpenFunc := 0;
  END;

  FUNCTION NewInOutFunc(var F: tTextRec): integer; FAR;
  BEGIN
    WITH F DO
      BEGIN
        _Buffer[BufPos] := #0; {so routines know where string ends}
        BufPos := 0;
      END;
    NewInOutFunc := 0;
  END;

  FUNCTION NewInOutFunc2(var F: tTextRec): integer; FAR;
  BEGIN
    WITH F DO _Buffer[BufPos] := #0;
    NewInOutFunc2 := 0;
  END;

  FUNCTION NewFlushFunc(var F: tTextRec): integer; FAR;
  BEGIN
    IF F.BufPos>0 THEN
      NewInOutFunc(F); {so that Close will not have to be called
                        to obtain all characters written}
    NewFlushFunc := 0;
  END;

  FUNCTION NewFlushFunc2(var F: tTextRec): integer; FAR;
  BEGIN
    IF F.BufPos>0 THEN
      NewInOutFunc2(F); {so that Close will not have to be called
                        to obtain all characters written}
    NewFlushFunc2 := 0;
  END;

  FUNCTION NewCloseFunc(var F: tTextRec): integer; FAR;
  BEGIN
    FreeMem(_Buffer,F.BufSize+1);
    NewCloseFunc := 0;
  END;

  PROCEDURE AssignWrite(var F: Text; Size: word;
    Accumulate : Boolean);
  BEGIN
    GetMem(_Buffer,Size+1);
    WITH tTextRec(F) DO
      BEGIN
        Mode      := fmClosed;
        BufSize   := Size;
        BufPtr    := pointer(_Buffer);
        OpenFunc  := @NewOpenFunc;
        IF Accumulate THEN
          BEGIN
            InOutFunc := @NewInOutFunc2;
            FlushFunc := @NewFlushFunc2;
          END
        ELSE
          BEGIN
            InOutFunc := @NewInOutFunc;
            FlushFunc := @NewFlushFunc;
          END;
        CloseFunc := @NewCloseFunc;
        Name[0] := #0;
      END;
  END;

END.